home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ad.arc / ADPRTA.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  5.5 KB  |  129 lines
  1. 10  ON ERROR GOTO 3940
  2. 30  GOTO 1380
  3. 70  CLS:COLOR 3,0,1:LOCATE  12,30:PRINT "QUIT?  <Y>es or <N>o?":COLOR 14,0:LOCATE 12,38:PRINT "Y":LOCATE 12,47:PRINT "N":COLOR 3,0:GOSUB 35000
  4. 80  Y$=INKEY$:IF Y$="" THEN 80
  5. 90  IF Y$="n" OR Y$="N" THEN RUN"adprt"
  6. 100  IF Y$="y" OR Y$="Y" THEN 110 ELSE 70
  7. 110  CLS:LOCATE 12,30:PRINT "GOODBYE":SYSTEM
  8. 120  REM
  9. 130  REM              PRINT
  10. 140  GOSUB 6000
  11. 150  CLOSE
  12. 200  RUN"adprt
  13. 1020  LOCATE 12,15:COLOR 14,0:PRINT "Do you want to use the Title of Courtesy?"
  14. 1030  LOCATE 14,30:COLOR 3,0:PRINT "<Y>es or <N>o?":LOCATE 14,31:COLOR 14,0:PRINT "Y":LOCATE 14,40:PRINT "N":COLOR 3,0:GOSUB 35030
  15. 1040  T$=INKEY$:IF T$="" THEN 1040 ELSE T$=CHR$(ASC(T$) AND &HDF):RETURN
  16. 1380  GOSUB 3000
  17. 1390  CLS:GOSUB 6000:GOSUB 1020
  18. 1400  X3$="FILE = ":X4$=SPACE$(12):X5$="FUNCTION = ":X1$="PRINT "
  19. 1410  X2$=" - ADDRESS":LOCATE 25,10:COLOR 1,7,1:PRINT X3$;FILE$;X4$;X5$;X1$;X2$;:COLOR 3,0
  20. 1425  LOCATE 20,40:PRINT SPACE$(39):LOCATE 21,40:PRINT SPACE$(39):LOCATE 22,40:PRINT SPACE$(20):LOCATE 23,40:PRINT SPACE$(20)
  21. 1430  GOSUB 2400
  22. 1450  GOSUB 1950
  23. 1460  MP1=LP1*6-9:K=1
  24. 1470  GET #4,NN+1:I=VAL(V$(16)):IK=0
  25. 1480  FOR L=1 TO 2
  26. 1482  IF IK=NN THEN IK=NN+1:GOTO 1620 ELSE IK=IK+1
  27. 1484  GET #4,I
  28. 1486  FOR J= 1 TO 7 :A(J,L)=VAL(V$(J)):NEXT
  29. 1488  A(8,L)=VAL(V$(13)):A(9,L)=VAL(V$(12)):A2=A(2,L)
  30. 1490  W$(6,L)=MID$(V$(5),5,A(5,L))+", "+MID$(V$(6),5,A(6,L))+"  "+MID$(V$(7),5,A(7,L))
  31. 1492  IF T$="N" THEN A9=36-A(2,L):GOTO 1498
  32. 1494  A9=36-A(8,L)-A(2,L):IF A9<A(1,L) THEN A(1,L)=A9
  33. 1498  A(5,L)=36-A(5,L)-A(6,L)-A(7,L)
  34. 1500  IF T$="Y" THEN W$(1,L)=MID$(V$(13),5,A(8,L))+MID$(V$(1),5,A(1,L))+" "+MID$(V$(2),5,A(2,L)):GOTO 1504
  35. 1502  W$(1,L)=MID$(V$(1),5,A(1,L))+" "+MID$(V$(2),5,A(2,L))
  36. 1504  IF A(9,L) <> 0 THEN W$(2,L)=MID$(V$(12),5,30) :GOTO 1510
  37. 1506  IF A(9,L) = 0 AND A(3,L)=0 THEN W$(2,L)=MID$(V$(4),5,30):W$(4,L)="":W$(5,L)="":W$(3,L)=W$(6,L):A(2,L)=10:A(3,L)=A(5,L):A(4,L)=40:A(5,L)=40:GOTO 1514
  38. 1508  IF A(9,L) = 0 AND A(3,L)<>0 THEN W$(2,L)=MID$(V$(3),5,30):W$(3,L)=MID$(V$(4),5,30):W$(4,L)=W$(6,L):W$(5,L)="":A(2,L)=10:A(3,L)=A(2,L):A(4,L)=A(5,L):A(5,L)=40:GOTO 1514
  39. 1510  IF A(9,L) <> 0 AND A(3,L)<>0 THEN W$(3,L)=MID$(V$(3),5,30):W$(4,L)=MID$(V$(4),5,30):A(2,L)=10:W$(5,L)=W$(6,L):A(3,L)=10:A(4,L)=10:GOTO 1514
  40. 1512  IF A(9,L) <>0 AND A(3,L)=0 THEN W$(3,L)=MID$(V$(4),5,30):W$(4,L)=W$(6,L):W$(5,L)="":A(2,L)=10:A(3,L)=A(2,L):A(4,L)=A(5,L):A(5,L)=40:GOTO 1514
  41. 1514  IF T$="Y" THEN A(1,L)=32-A(1,L)-A2-A(8,L) ELSE A(1,L)=32-A(1,L)-A2
  42. 1518  IF A(1,L)<=0 THEN A(1,L)=3
  43. 1522  I=VAL(V$(14)):NEXT
  44. 1620  IF MP<MP1 THEN 1670 ELSE K=K+1
  45. 1630  IF LP$="N" OR LP$="n" THEN 1660 ELSE LOCATE 24,1:PRINT "Advance paper and hit any key to continue";:GOSUB 35010
  46. 1640  Y$=INKEY$:IF Y$="" THEN 1640 ELSE LOCATE 24,1:PRINT SPACE$(50);
  47. 1650  PRINT #5,   TAB(35);"-";K;" -":PRINT #5, :PRINT #5,  :MP=6:GOTO 1670
  48. 1660  PRINT #5, CHR$(12):PRINT #5,:PRINT #5,  TAB(35);"- ";K;" -":PRINT #5, :PRINT #5, :MP=5
  49. 1670  S=IK-1
  50. 1680  IF S<>NN THEN 1690 ELSE IF N1 =0 THEN 1690 ELSE 1880
  51. 1690  IS$=STR$(S):IS1$=STR$(S+1):IF S<=9 THEN IS$="  "+IS$
  52. 1700  IF S+1<=9 THEN IS1$="  "+IS1$
  53. 1710  IF S>9 AND S<100 THEN IS$=" "+IS$
  54. 1720  IF S+1>9 AND S<100 THEN IS1$=" "+IS1$
  55. 1725  IF IK=NN+1 THEN 1880
  56. 1730  PRINT #5,  TAB(1);IS$;".  ";W$(1,1);SPACE$(A(1,1));IS1$;".  ";W$(1,2)
  57. 1740  PRINT #5, TAB(8);W$(2,1);SPACE$(A(2,1));W$(2,2)
  58. 1750  PRINT #5, TAB(8);W$(3,1);SPACE$(A(3,1));W$(3,2)
  59. 1760  IF W$(4,1) ="" AND W$(4,2)=""THEN 1770 ELSE PRINT #5, TAB(8);W$(4,1);SPACE$(A(4,1));W$(4,2):MP=MP+1
  60. 1770  IF W$(5,1)="" AND W$(5,2)="" THEN 1780 ELSE PRINT #5, TAB(8);W$(5,1);SPACE$(A(5,1));W$(5,2):MP=MP+1
  61. 1780  MP=MP+5
  62. 1790  PRINT #5, :PRINT #5, 
  63. 1792  Y$=INKEY$:IF Y$=CHR$(27) THEN GOSUB 2500
  64. 1800  IF IK=>NN THEN 1870
  65. 1810  IF FRE(1)>1000 THEN 1480
  66. 1820  CHAIN "adprta",1850,ALL
  67. 1850  GOTO 1480
  68. 1870  RUN"adprt
  69. 1880  PRINT #5,  TAB(1);IS$;".  ";W$(1,1):PRINT #5, TAB(8);W$(2,1)
  70. 1890  PRINT #5,  TAB(8);W$(3,1):PRINT #5, TAB(8);W$(4,1)
  71. 1900  PRINT #5,  TAB(8);W$(5,1)
  72. 1920  PRINT #5,  :PRINT #5,
  73. 1930  RUN"adprt
  74. 1950  REM
  75. 2110  PRINT #5, 
  76. 2120  PRINT #5,  SPACE$(TN);T1$
  77. 2130  B=VAL(LEFT$(DATE$,2))
  78. 2140  PRINT #5, :PRINT #5,  SPACE$(30);DQ$(B);" ";MID$(DATE$,4,2);", 19";RIGHT$(DATE$,2):PRINT #5, 
  79. 2150  PRINT #5, 
  80. 2160  MP =10
  81. 2170  RETURN
  82. 2400  COLOR 0,7:LOCATE 21,1:PRINT "TURN ON PRINTER AND HIT ANY KEY":COLOR 3,0:GOSUB 35010
  83. 2410  GOSUB 5000
  84. 2420  LOCATE 21,1:PRINT SPACE$(40):LOCATE 21,10:COLOR 16,7:PRINT "WORKING":COLOR 3,0
  85. 2430  LOCATE 23,1:COLOR 10,0:PRINT "Hit <Esc> to stop printing.":COLOR 3,0
  86. 2440  RETURN
  87. 2500  COLOR 10,0:LOCATE 21,1:PRINT "Hit any key to continue PRINTING":GOSUB 35010
  88. 2510  LOCATE 23,1:COLOR 10,0:PRINT "Hit KEY F6 - Return to Menu.":COLOR 3,0
  89. 2520  GOSUB 5000:GOSUB 2420:RETURN
  90. 3000  O5$=CHR$(218)+CHR$(196)+CHR$(191):O6$=CHR$(179)+" "+CHR$(179):O7$=CHR$(192)+CHR$(196)+CHR$(217)
  91. 3010  O$=CHR$(219):O2$=CHR$(221):O1$="F KEYS:"+O$+O$+"F1:MAIN menu"+O2$+"F2:PRINT-MAIL menu"+O2$+"F6:PRINT menu"+O2$+"F8:NAMES"+O2$+"F4:NOTES"
  92. 3020  DIM DQ$(12):FOR I= 1 TO 12:READ DQ$(I):NEXT
  93. 3030  DATA JANUARY, FEBRUARY,MARCH,APRIL,MAY,JUNE,JULY,AUGUST,SEPTEMBER,OCTOBER,NOVEMBER,DECEMBER
  94. 3040  WIDTH "LPT1:",82
  95. 3050  OPEN "TEMPOR.TEM" FOR INPUT AS #1
  96. 3055  INPUT #1, FILE$,FILM$,FIL$:CLOSE #1
  97. 3056  OPEN FILM$ FOR INPUT AS #2
  98. 3060  INPUT #2,Y$,NRED,NN,FILE$,FIL$,PT$,SNN$,LP1,LP$,T1$,SND$,TN,F$:CLOSE #2
  99. 3065  DIM V$(16),D%(NN),W$(9,2),A(9,2)
  100. 3070  IF PT$="I" THEN OPEN "LPT1:" FOR OUTPUT AS #5:GOTO 3090
  101. 3080  OPEN "LPT2:" FOR OUTPUT AS #5
  102. 3090  OPEN FILE$ AS #4 LEN = 356
  103. 3100  FIELD #4, 19 AS V$(1), 19 AS V$(2), 18 AS V$(13), 34 AS V$(12), 34 AS V$(3), 34 AS V$(4), 19 AS V$(5), 14 AS V$(6), 16 AS V$(7), 12 AS V$(8), 84 AS V$(9), 19 AS V$(10), 19 AS V$(11), 5 AS V$(14), 5 AS V$(15), 5 AS V$(16)
  104. 3120  FILN$=FIL$+".NTE"
  105. 3130  RETURN
  106. 3840  RUN"adprt.bas"
  107. 3940  IF ERR = 27 THEN CLS:LOCATE 25,10:COLOR 1,7,1:PRINT "FILE = ";FILE$;SPACE$(10);"PRINTER ERROR ":COLOR 7,1:LOCATE 1,1
  108. 3950  IF ERR = 27 THEN PRINT "CHECK THE PRINTER":FOR I= 1 TO 500:NEXT I:RUN"adprt"
  109. 3970  IF ERR =53 THEN CLS:LOCATE 10,15:PRINT "File containing KEYS used in NOTES does not exist.":LOCATE 12,22:PRINT "Return to EDIT program to create file." :LOCATE 18,30:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030:Y$=INPUT$(1):RESUME 140
  110. 3981  CLS:LOCATE 10,28:PRINT "ERROR ";ERR;" ENCOUNTERED":LOCATE 18,26:PRINT "HIT ANY KEY TO CONTINUE":GOSUB 35030
  111. 3982  Y$=INKEY$:IF Y$="" THEN 3982
  112. 3985  RESUME 140
  113. 5000  Y$=INKEY$:IF Y$="" THEN LOCATE 3,69:PRINT TIME$:GOTO 5000 ELSE RETURN
  114. 5200  A$="EDIT":Y1=2:GOTO 5250
  115. 5205  A$="PRINT":Y1=6:GOTO 5250
  116. 5210  A$="DELETE":Y1=3:GOTO 5250
  117. 5220  A$="SORT":Y1=4:GOTO 5250
  118. 5230  A$="SEARCH":Y1=5:GOTO 5250
  119. 5240  A$="MAIN":Y1=1
  120. 5250  CLS:LOCATE 25,25:COLOR 1,7,1:PRINT "INTEGRATED SOFTWARE SYSTEMS";:COLOR 3,0:LOCATE 12,21:PRINT "PLEASE WAIT, LOADING ";A$;" ROUTINES"
  121. 5260  IF Y1=6 THEN RUN "ADPRT.BAS"
  122. 5270  A$="AD"+A$:RUN A$
  123. 6000  ON KEY(8) GOSUB 3840:KEY(8) ON:ON KEY(7) GOSUB 3840:KEY(7) ON
  124. 6010  ON KEY(1) GOSUB 5240:ON KEY(2) GOSUB 5200:KEY(1) ON:KEY(2) ON:ON KEY(3) GOSUB 5210:KEY(3) ON:ON KEY(4) GOSUB 5220:KEY(4) ON:ON KEY(5) GOSUB 5230:ON KEY(6) GOSUB 130:KEY(6) ON:KEY(5) ON
  125. 6020  RETURN
  126. 35000  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 4:SOUND 500*SS%,2:NEXT:RETURN
  127. 35010  IF SND$="N" THEN RETURN ELSE FOR SS%=1 TO 3:SOUND 1000*SS%,1:NEXT:FOR SS%= 3 TO 1:SOUND 1000*SS%,1:NEXT:RETURN
  128. 35030  IF SND$="N" THEN RETURN ELSE SOUND 750,2:SOUND 30000,2:SOUND 750,2:RETURN
  129.